home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / term / post-x-win.el < prev    next >
Encoding:
Text File  |  1995-08-09  |  9.9 KB  |  255 lines
  1. ;;; post-x-win.el --- second phase of runtime initialization for X windows
  2. ;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
  3. ;; Copyright (C) 1995 Board of Trustees, University of Illinois.
  4.  
  5. ;; Author: FSF
  6. ;; Keywords: terminals
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; post-x-win.el: this file is loaded either from ../term/x-win.el or
  27. ;; by make-device when it creates the first X device.
  28.  
  29. ;;; Code:
  30.  
  31.  
  32. ;; We can't load this until after the initial X device is created
  33. ;; because the icon initialization needs to access the display to get
  34. ;; any toolbar-related color resources.
  35. (require 'x-toolbar)
  36.  
  37.  
  38. ;;; selections and active regions
  39.  
  40. ;;; If and only if zmacs-regions is true:
  41. ;;;
  42. ;;; When a mark is pushed and the region goes into the "active" state, we
  43. ;;; assert it as the Primary selection.  This causes it to be hilighted.
  44. ;;; When the region goes into the "inactive" state, we disown the Primary
  45. ;;; selection, causing the region to be dehilighted.
  46. ;;;
  47. ;;; Note that it is possible for the region to be in the "active" state
  48. ;;; and not be hilighted, if it is in the active state and then some other
  49. ;;; application asserts the selection.  This is probably not a big deal.
  50.  
  51. (defun x-activate-region-as-selection ()
  52.   (if (marker-buffer (mark-marker t))
  53.       (x-own-selection (cons (point-marker t) (mark-marker t)))))
  54.  
  55. ;;; these are only ever called if zmacs-regions is true.
  56. (add-hook 'zmacs-deactivate-region-hook 'x-disown-selection)
  57. (add-hook 'zmacs-activate-region-hook 'x-activate-region-as-selection)
  58. (add-hook 'zmacs-update-region-hook 'x-activate-region-as-selection)
  59.  
  60.  
  61. ;; Keypad type things
  62.  
  63. (defun fkey-popup-mode-menu ()
  64.   (interactive)
  65.   (call-interactively (key-binding [(button3)])))
  66.  
  67. ;;; These aren't bound to kbd macros like "\C-b" so that they have the
  68. ;; expected behavior even in, for example, vi-mode.
  69.  
  70. ;; We use here symbolic names, assuming that the corresponding keys will
  71. ;; generate these keysyms.  This is not true on Suns, but x-win-sun.el 
  72. ;; fixes that.  If it turns out that the semantics of these keys should
  73. ;; differ from server to server, this should be moved into server-specific
  74. ;; files, but these appear to be the standard Motif and PC bindings.
  75.  
  76. ;; potential R6isms
  77. (define-key global-map 'kp_left        'fkey-backward-char)
  78. (define-key global-map 'kp_up        'fkey-previous-line)
  79. (define-key global-map 'kp_right    'fkey-forward-char)
  80. (define-key global-map 'kp_down        'fkey-next-line)
  81.  
  82.  
  83. ;; movement by larger blocks
  84. (define-key global-map '(control left)    'fkey-backward-word)
  85. (define-key global-map '(control up)    #'(lambda ()
  86.                         (interactive "_")
  87.                         (forward-line -6)))
  88. (define-key global-map '(control right)    'fkey-forward-word)
  89. (define-key global-map '(control down)    #'(lambda ()
  90.                         (interactive "_")
  91.                         (forward-line 6)))
  92.  
  93. ;; context-sensitive movement
  94. (define-key global-map '(meta left)  'fkey-backward-sexp)
  95. (define-key global-map '(meta right) 'fkey-forward-sexp)
  96. (define-key global-map '(meta up)    'fkey-backward-paragraph)
  97. (define-key global-map '(meta down)  'fkey-forward-paragraph)
  98.  
  99. ;; movement by pages
  100. (define-key global-map '(control prior)    'fkey-scroll-right)
  101. (define-key global-map '(control next)    'fkey-scroll-left)
  102. ;; potential R6isms
  103. (define-key global-map 'kp_prior    'fkey-scroll-down)
  104. (define-key global-map 'kp_next        'fkey-scroll-up)
  105. (define-key global-map '(control kp_prior) 'fkey-scroll-right)
  106. (define-key global-map '(control kp_next) 'fkey-scroll-left)
  107. ;; potential Sunisms
  108. (define-key global-map 'pgup        'fkey-scroll-down)
  109. (define-key global-map 'pgdn        'fkey-scroll-up)
  110. (define-key global-map '(control pgup)    'fkey-scroll-right)
  111. (define-key global-map '(control pgdn)    'fkey-scroll-left)
  112.  
  113.  
  114. ;; movement to the limits
  115. (define-key global-map '(control home)    'fkey-beginning-of-buffer)
  116. (define-key global-map '(control end)    'fkey-end-of-buffer)
  117. (define-key global-map 'begin        'fkey-beginning-of-line)
  118. (define-key global-map '(control begin)    'fkey-beginning-of-buffer)
  119. ;; potential R6isms
  120. (define-key global-map 'kp_home        'fkey-beginning-of-line)
  121. (define-key global-map '(control kp_home) 'fkey-beginning-of-buffer)
  122. (define-key global-map 'kp_end        'fkey-end-of-line)
  123. (define-key global-map '(control kp_end) 'fkey-end-of-buffer)
  124.  
  125. ;; movement between windows
  126. (define-key global-map '(control tab)    'fkey-other-window)
  127. (define-key global-map '(control shift tab) 'fkey-backward-other-window)
  128.  
  129. ;; movement in other windows
  130. (define-key global-map '(meta next)    'fkey-scroll-other-window)
  131. (define-key global-map '(meta prior)    'scroll-other-window-down)
  132. (define-key global-map '(meta home)    'beginning-of-buffer-other-window)
  133. (define-key global-map '(meta end)    'end-of-buffer-other-window)
  134. ;; potential R6isms
  135. (define-key global-map '(meta kp_next)    'fkey-scroll-other-window)
  136. (define-key global-map '(meta kp_prior)    'scroll-other-window-down)
  137. (define-key global-map '(meta kp_home)    'beginning-of-buffer-other-window)
  138. (define-key global-map '(meta kp_end)    'end-of-buffer-other-window)
  139. ;; potential Sunisms
  140. (define-key global-map '(meta pgdn)    'fkey-scroll-other-window)
  141. (define-key global-map '(meta pgup)    'scroll-other-window-down)
  142.  
  143.  
  144. ;; potential R6isms
  145. (define-key global-map 'redo        'fkey-repeat-complex-command)
  146. (define-key global-map 'kp_insert    'fkey-overwrite-mode)
  147. (define-key global-map 'kp_delete    'backward-delete-char-untabify)
  148.  
  149. (define-key global-map 'kp_enter    [return]) ; do whatever RET does now
  150. (define-key global-map 'kp_tab        [tab])
  151.  
  152. (define-key global-map 'undo        'undo)
  153. (define-key global-map 'help        'help-for-help)
  154. (define-key help-map   'help        'help-for-help)
  155.  
  156. ;; Motif-ish bindings
  157. ;; The following two were generally unliked.
  158. ;(define-key global-map '(shift delete)    'x-kill-primary-selection)
  159. ;(define-key global-map '(control delete) 'x-delete-primary-selection)
  160. (define-key global-map '(shift insert)    'x-yank-clipboard-selection)
  161. (define-key global-map '(control insert)    'x-copy-primary-selection)
  162. ;; (Are these Sunisms?)
  163. (define-key global-map 'copy        'x-copy-primary-selection)
  164. (define-key global-map 'paste        'x-yank-clipboard-selection)
  165. (define-key global-map 'cut        'x-kill-primary-selection)
  166.  
  167. (define-key global-map 'menu        'fkey-popup-mode-menu)
  168. ;(define-key global-map '(shift menu)    'x-goto-menubar) ;NYI
  169.  
  170. ;; if we define these this way (instead of leaving them bound to self-
  171. ;; insert-command), then the show-bindings display is hideously cluttered.
  172. ;(define-key global-map 'kp_space    " ")
  173. ;(define-key global-map 'kp_equal    "=")
  174. ;(define-key global-map 'kp_multiply    "*")
  175. ;(define-key global-map 'kp_add        "+")
  176. ;(define-key global-map 'kp_separator    ",")
  177. ;(define-key global-map 'kp_subtract    "-")
  178. ;(define-key global-map 'kp_decimal    ".")
  179. ;(define-key global-map 'kp_divide    "/")
  180.  
  181.  
  182. ;;; OpenWindows-like "find" processing.  These functions are really Sunisms,
  183. ;;; but we put them here instead of in x-win-sun.el in case someone wants
  184. ;;; to use them when not running on a Sun console (presumably after adding
  185. ;;; the to different keys, or putting them on menus.)
  186.  
  187. (defvar ow-find-last-string nil)
  188. (defvar ow-find-last-clipboard nil)
  189.  
  190. (defun ow-find (&optional backward-p)
  191.   "Search forward the next occurence of the text of the selection."
  192.   (interactive)
  193.   (let ((sel (condition-case () (x-get-selection) (error nil)))
  194.     (clip (condition-case () (x-get-clipboard) (error nil)))
  195.     text)
  196.     (setq text (cond
  197.         (sel)
  198.         ((not (equal clip ow-find-last-clipboard))
  199.          (setq ow-find-last-clipboard clip))
  200.         (ow-find-last-string)
  201.         (t (error "No selection available"))))
  202.     (setq ow-find-last-string text)
  203.     (cond (backward-p
  204.        (search-backward text)
  205.        (set-mark (+ (point) (length text))))
  206.       (t
  207.        (search-forward text)
  208.        (set-mark (- (point) (length text)))))
  209.     (zmacs-activate-region)))
  210.  
  211. (defun ow-find-backward ()
  212.   "Search backward the previous occurence of the text of the selection."
  213.   (interactive)
  214.   (ow-find t))
  215.  
  216.  
  217. ;;; Load X-server specific code.
  218. ;;; Specifically, load some code to repair the grievous damage that MIT and
  219. ;;; Sun have done to the default keymap for the Sun keyboards.
  220.  
  221. (defun x-initialize-keyboard ()
  222.   (cond (;; This is some heuristic junk that tries to guess whether this is
  223.      ;; a Sun keyboard.
  224.      ;;
  225.      ;; One way of implementing this (which would require C support) would
  226.      ;; be to examine the X keymap itself and see if the layout looks even
  227.      ;; remotely like a Sun - check for the Find key on a particular
  228.      ;; keycode, for example.  It'd be nice to have a table of this to
  229.      ;; recognize various keyboards; see also xkeycaps.
  230.      ;;
  231.      (let ((vendor (x-server-vendor)))
  232.        (or (string-match "Sun Microsystems" vendor)
  233.            ;; MIT losingly fails to tell us what hardware the X server
  234.            ;; is managing, so assume all MIT displays are Suns...  HA HA!
  235.            (string-equal "MIT X Consortium" vendor)
  236.            (string-equal "X Consortium" vendor)))
  237.        ;;
  238.        ;; Ok, we think this could be a Sun keyboard.  Load the Sun code.
  239.        ;;
  240.        (load (concat term-file-prefix "x-win-sun") nil t)
  241.        )
  242.     ((string-match "XFree86" (x-server-vendor))
  243.      ;; Those XFree86 people do some weird keysym stuff, too.
  244.      (load (concat term-file-prefix "x-win-xfree86") nil t))
  245.       ))
  246.  
  247. ;; This runs after the first frame has been created (we can't talk to the X
  248. ;; server before that) but before the site-start-file or .emacs file, so sites
  249. ;; and users have a chance to override it.
  250. (add-hook 'before-init-hook 'x-initialize-keyboard)
  251.  
  252. (provide 'post-x-win)
  253.  
  254. ;;; post-x-win.el ends here
  255.